home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / TEST / L.M < prev    next >
Encoding:
Text File  |  1992-06-04  |  10.4 KB  |  3 lines
  1. ⓪ MODULE LibManager;⓪ IMPORT Debug;⓪ ⓪ (*⓪!* Ermöglicht Zugriff auf den Inhalt von Megamax Library-Dateien⓪!*⓪!* Erstellt Frühjahr/Sommer 1989 von Thomas Tempelmann      (Stand: 14.01.91)⓪!*⓪!*   Hier noch ein paar Anregungen für lange Winterabende, an denen⓪!* sonst nix zu tun ist:⓪!*   - Mit dem Modul 'WindowLists' könnte die Anzeige und Auswahl der Dateien⓪!*     in der Library übersichtlicher gestaltet werden.⓪!*   - Das Löschen oder Anzeigen der Dateien in der Lib könnte mit der⓪!*     Funktion 'NameMatching' aus 'FileNames' auch über sog. 'Wildcards'⓪!*     ermöglicht werden.⓪!*   Und wenn Sie tatsächlich solche oder andere Verbesserungen an den⓪!* Megamax-Hilfsprogrammen vorgenommen haben, schicken Sie sie uns doch⓪!* zurück. Wir würden sie dann gerne durch unsere Versionen ersetzen.⓪!* Auch wenn es keine echten MEMOX-Beiträge wären, bieten wir Ihnen trotzdem⓪!* eine MEMOX-Disk im Tausch.⓪!*)⓪ ⓪ IMPORT GEMIO;⓪ IMPORT VT52;⓪ FROM EasyGEM1 IMPORT SelectFile, SelectMask;⓪ FROM BinOps IMPORT LowerLCard;⓪ IMPORT Clock, TimeConvert, MOSGlobals, Files, Binary;⓪ FROM Directory IMPORT Delete, DirQuery, DirQueryProc, DirEntry, FileAttrSet,⓪(SetFileAttr;⓪ FROM FileNames IMPORT FileName, FilePath, ConcatName, FileSuffix, ValidatePath;⓪ FROM MOSGlobals IMPORT FileStr, PathStr, fNoMatchingFiles;⓪ FROM InOut IMPORT Write, WriteString, WriteCard, WriteLn, Read, WritePg,⓪(ReadString, GotoXY;⓪ IMPORT LibFiles;⓪ FROM Strings IMPORT Assign, Space, Length, Empty, Append, String;⓪ FROM FuncStrings IMPORT ConcStr;⓪ FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;⓪ ⓪ TYPE Cmd = (quit, open, list, add, remove, extract);⓪%Ascii = SET OF CHAR;⓪ ⓪ VAR ok: BOOLEAN;⓪$ch: CHAR;⓪$f: Files.File;⓪$path, libName: FileStr;⓪$lib: LibFiles.LibFile;⓪$r: INTEGER;⓪$all: BOOLEAN;⓪$count: CARDINAL;⓪$copybuffer: ARRAY [1..$2000] OF CARDINAL;⓪ ⓪ ⓪ PROCEDURE get (a: Ascii): CHAR;⓪"VAR c: CHAR;⓪"BEGIN⓪$REPEAT⓪&Read (c);⓪&IF c >= ' ' THEN Write (CHR (8)) END;⓪&c:= CAP (c);⓪$UNTIL c IN a;⓪$RETURN c⓪"END get;⓪ ⓪ PROCEDURE yes (): BOOLEAN;⓪"BEGIN⓪$RETURN get (Ascii{'J','N'}) = 'J'⓪"END yes;⓪ ⓪ PROCEDURE wait;⓪"VAR c: CHAR;⓪"BEGIN⓪$WriteString ('Taste...');⓪$Read (c)⓪"END wait;⓪ ⓪ PROCEDURE weiter (): BOOLEAN;⓪"VAR c: CHAR;⓪"BEGIN⓪$WriteString ('Weiter? (J/N) ');⓪$RETURN yes ()⓪"END weiter;⓪ ⓪ PROCEDURE error (taste: BOOLEAN);⓪"VAR s: ARRAY [0..31] OF CHAR;⓪"BEGIN⓪$WriteLn;⓪$Files.GetStateMsg (r, s);⓪$WriteString ('Fehler: ');⓪$WriteString (s);⓪$WriteLn;⓪$IF taste THEN wait END;⓪$r:= 0⓪"END error;⓪ ⓪ PROCEDURE ferror (f: Files.File);⓪"BEGIN⓪$r:= Files.State (f);⓪$error (TRUE)⓪"END ferror;⓪ ⓪ ⓪ PROCEDURE openLib;⓪"VAR s: FileStr;⓪"BEGIN⓪$WritePg;⓪$s:= '';⓪$ConcatName (SelectMask, 'M2L', SelectMask);⓪$SelectFile ('Wähle Library', s, ok);⓪$ConcatName (SelectMask, '*', SelectMask);⓪$IF NOT ok OR (LENGTH (FileName (s)) = 0) THEN RETURN END;⓪$IF LENGTH (FileSuffix (s)) = 0 THEN⓪&ConcatName (s, 'M2L', s)⓪$END;⓪$LibFiles.OpenLib (lib, s, r);⓪$IF (r = MOSGlobals.fPathNotFound) OR (r = MOSGlobals.fFileNotFound) THEN⓪&WriteLn;⓪&WriteString (⓪('Library existiert nicht. Soll sie neu angelegt werden ? (J/N) ');⓪&IF yes () THEN⓪(LibFiles.CreateLib (s, r);⓪(IF r < 0 THEN⓪*libName:= '';⓪*error (TRUE);⓪*RETURN⓪(END;⓪(LibFiles.OpenLib (lib, s, r)⓪&END⓪$END;⓪$IF r < 0 THEN⓪&error (TRUE)⓪$ELSE⓪&libName:= s⓪$END;⓪$LibFiles.CloseLib (lib);⓪"END openLib;⓪ ⓪ ⓪ PROCEDURE showEntry ( f: LibFiles.LibEntry ): BOOLEAN;⓪"VAR s: String;⓪"BEGIN⓪$IF count = 0 THEN⓪&count:= 18;⓪&wait;⓪&WritePg⓪$END;⓪$DEC (count);⓪$WriteString (f.name);⓪$WriteString (Space (14-Length (f.name)));⓪$WriteCard (f.size,7);⓪$WriteString ('   ');⓪$TimeConvert.DateToText ( Clock.UnpackDate (f.date), '', s);⓪$WriteString (s);⓪$WriteString ('   ');⓪$TimeConvert.TimeToText ( Clock.UnpackTime (f.time), '', s);⓪$WriteString (s);⓪$WriteLn;⓪$RETURN TRUE⓪"END showEntry;⓪ ⓪ PROCEDURE showLib;⓪"BEGIN⓪$WritePg;⓪$count:= 18;⓪$LibFiles.OpenLib (lib, libName, r);⓪$IF r < 0 THEN error (TRUE); RETURN END;⓪$LibFiles.LibQuery (lib, showEntry, r);⓪$LibFiles.CloseLib (lib);⓪$WriteLn;⓪$IF r < 0 THEN error (TRUE) ELSE WriteLn; wait END⓪"END showLib;⓪ ⓪ ⓪ PROCEDURE readEntry ( d: LibFiles.LibEntry ): BOOLEAN;⓪"VAR f: Files.File; rd,n: LONGCARD;⓪"BEGIN⓪$(*$D+*)⓪$WriteLn;⓪$WriteString (d.name);⓪$WriteString (VT52.Seq[VT52.flush]);⓪$Files.Create (f, ConcStr (path, d.name),⓪2Files.writeOnly, Files.noReplace);⓪$IF Files.State (f) = MOSGlobals.fFileExists THEN⓪&WriteString ('  -  Datei existiert schon ! Überschreiben ? (J/N) ');⓪&IF yes () THEN⓪(Files.Create (f, ConcStr (path, d.name), Files.writeOnly,⓪0Files.replaceOld);⓪&ELSE⓪(RETURN TRUE⓪&END⓪$END;⓪$IF Files.State (f) < 0 THEN⓪&ferror (f);⓪&RETURN FALSE⓪$END;⓪$(*$D-*)⓪$Binary.Seek (lib.f, d.start, Binary.fromBegin);⓪$rd:= LowerLCard (SIZE (copybuffer), d.size);⓪$n:= d.size;⓪$REPEAT⓪&Binary.ReadBytes (lib.f, ADR (copybuffer), rd, rd);⓪&Binary.WriteBytes (f, ADR (copybuffer), rd);⓪&n:= n - rd;⓪&IF Files.State (f) < 0 THEN⓪(ferror (f); Files.Remove (f); RETURN FALSE⓪&END;⓪$UNTIL n = 0L;⓪$Files.Close (f);⓪$IF Files.State (f) < 0 THEN ferror (f); RETURN FALSE END;⓪$Files.Open (f, ConcStr (path, d.name), Files.readOnly);⓪$Files.SetDateTime (f, Clock.UnpackDate(d.date), Clock.UnpackTime(d.time));⓪$Files.Close (f);⓪$SetFileAttr (ConcStr (path, d.name), d.attr, r);⓪$RETURN TRUE⓪"END readEntry;⓪ ⓪ PROCEDURE readFile;⓪"VAR d: LibFiles.LibEntry; l,c: CHAR;⓪&s: FileStr;⓪"BEGIN⓪$WritePg;⓪$LibFiles.OpenLib (lib, libName, r);⓪$IF r < 0 THEN error (TRUE); RETURN END;⓪$WriteString ('Alle Dateien oder Eine ? (A/E) ');⓪$c:= get (Ascii{'A','E',33C});⓪$IF c=33C THEN LibFiles.CloseLib (lib); RETURN END;⓪$WriteLn;⓪$WriteLn;⓪$WriteString ('Ziel-Verzeichnis: ');⓪$s:= '';⓪$SelectFile ('Ziel-Verzeichnis?', s, ok);⓪$IF NOT ok THEN LibFiles.CloseLib (lib); RETURN END;⓪$Assign (FilePath (SelectMask), path, ok);⓪$WriteString (path);⓪$IF c = 'A' THEN⓪&LibFiles.LibQuery (lib, readEntry, r);⓪$ELSE⓪&WriteLn;⓪&WriteString ('Welche Datei aus der Library herauskopieren? ');⓪&ReadString (s);⓪&LibFiles.LookUp (lib, s, d, r);⓪&IF r >= 0 THEN⓪(IF readEntry (d) THEN END;⓪&END⓪$END;⓪$LibFiles.CloseLib (lib);⓪$IF r < 0 THEN error (TRUE) END;⓪"END readFile;⓪ ⓪ ⓪ PROCEDURE delLib;⓪"BEGIN⓪$WriteLn;⓪$WriteString ('Library ist beschädigt und wird gelöscht.');⓪$Delete (libName, r);⓪$libName:= '';⓪$WriteLn;⓪$wait;⓪"END delLib;⓪ ⓪ PROCEDURE insFile (REF path: ARRAY OF CHAR; e: DirEntry): BOOLEAN;⓪ ⓪"VAR c: CHAR; dam: BOOLEAN;⓪&d: LibFiles.LibEntry;⓪&l, f: Files.File;⓪&n: LONGCARD;⓪ ⓪"BEGIN⓪$WriteLn;⓪$WriteString (e.name);⓪$WriteString (VT52.Seq[VT52.flush]);⓪$IF ~all THEN⓪&WriteString (' ? (Ja/Nein/Alle/Fertig) ');⓪&c:= get (Ascii{'J','N','A','F'});⓪&IF c='F' THEN⓪(RETURN FALSE⓪&ELSIF c='N' THEN⓪(RETURN TRUE⓪&ELSIF c='A' THEN⓪(all:= TRUE⓪&END⓪$END;⓪$WITH d DO⓪&name:= e.name;⓪&size:= e.size;⓪&attr:= e.attr;⓪&date:= Clock.PackDate (e.date);⓪&time:= Clock.PackTime (e.time);⓪$END;⓪$LibFiles.AddFile (libName, d, dam, r);⓪$IF r < 0 THEN⓪&error (FALSE); (* hier noch nicht auf Taste warten *)⓪&IF dam THEN⓪(delLib; (* wartet auf Taste *)⓪(RETURN FALSE⓪&END;⓪&RETURN weiter ()⓪$END;⓪$Files.Open (l, libName, Files.writeOnly);⓪$Binary.Seek (l, d.start, Binary.fromBegin);⓪$Files.Open (f, ConcStr (path, e.name), Files.readOnly);⓪$n:= SIZE (copybuffer);⓪$REPEAT⓪&Binary.ReadBytes (f, ADR (copybuffer), n, n);⓪&Binary.WriteBytes (l, ADR (copybuffer), n);⓪$UNTIL n = 0L;⓪$Files.Close (f);⓪$Files.Close (l);⓪$IF Files.State (l) < 0 THEN ferror (l); delLib; RETURN FALSE END;⓪$RETURN TRUE⓪"END insFile;⓪ ⓪ PROCEDURE newFile;⓪"VAR s: FileStr;⓪"BEGIN⓪$WritePg;⓪$WriteString ('Name der einzufügenden Datei(en) (auch Wildcards, z.B "*.DEF")? ');⓪$WriteString (VT52.Seq[VT52.flush]);⓪$WriteLn;⓪$s:= '';⓪$SelectFile ('Wähle Datei(en)', s, ok);⓪$IF NOT ok OR (LENGTH (FileName (s)) = 0) THEN RETURN END;⓪$all:= FALSE;⓪$DirQuery (s, FileAttrSet {}, insFile, r);⓪$IF r < 0 THEN⓪&error (TRUE)⓪$ELSIF r = fNoMatchingFiles THEN⓪&WriteLn;⓪&WriteString ('Keine passenden Dateien gefunden!');⓪&WriteLn;⓪&wait⓪$END⓪"END newFile;⓪ ⓪ ⓪ PROCEDURE delFile;⓪"VAR s: FileStr; dam: BOOLEAN;⓪"BEGIN⓪$WritePg;⓪$WriteString ('Name der in der Library zu löschenden Datei? ');⓪$ReadString (s);⓪$IF Empty (s) THEN RETURN END;⓪$LibFiles.RemoveFile (libName, s, dam, r);⓪$IF r < 0 THEN⓪&error (TRUE);⓪&IF dam THEN delLib END⓪$END⓪"END delFile;⓪ ⓪ ⓪ PROCEDURE menu (onlyOpen: BOOLEAN);⓪"BEGIN⓪$WritePg;⓪$GotoXY (20, 1);⓪$WriteString ('Megamax Modula-2 Library Manager');⓪$GotoXY (0, 3);⓪$IF Empty (libName) THEN⓪&WriteString ('Noch keine Library gewählt');⓪$ELSE⓪&WriteString ('Aktuelle Library: ');⓪&WriteString (libName);⓪$END;⓪$GotoXY (0, 6);⓪$WriteString (' W - Library wählen / anlegen');⓪$WriteLn;⓪$IF NOT onlyOpen THEN⓪&WriteString (' I - Inhalt der Library zeigen');⓪&WriteLn;⓪&WriteString (' L - Eine Datei aus Library löschen');⓪&WriteLn;⓪&WriteString (' E - Neue Datei(en) in Library einfügen');⓪&WriteLn;⓪&WriteString (' K - Datei(en) aus Library herauskopieren');⓪&WriteLn;⓪$END;⓪$WriteString (' Q - Ende');⓪"END menu;⓪ ⓪ PROCEDURE wahl (onlyOpen: BOOLEAN): Cmd;⓪"VAR c: CHAR; s: Ascii;⓪"BEGIN⓪$IF onlyOpen THEN⓪&s:= Ascii {'W','Q'};⓪$ELSE⓪&s:= Ascii {'W','I','E','L','K','Q'};⓪$END;⓪$GotoXY (0, 5);⓪$WriteString ('Wähle: ');⓪$CASE get (s) OF⓪&'W': RETURN open |⓪&'I': RETURN list |⓪&'E': RETURN add |⓪&'L': RETURN remove |⓪&'K': RETURN extract |⓪&'Q': RETURN quit⓪$END⓪"END wahl;⓪ ⓪ BEGIN⓪"SelectMask:= '*.*';⓪"WriteString (VT52.Seq[VT52.enhancedOn]); (* Global: schnelle Ausgaben *)⓪"LOOP⓪$menu (Empty (libName));⓪$CASE wahl (Empty (libName)) OF⓪&open: openLib |⓪&list: showLib |⓪&add: newFile |⓪&remove: delFile |⓪&extract: readFile |⓪&quit: EXIT⓪$END⓪"END⓪ END LibManager.⓪ ə
  2. (* $FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBAÇ$000018BCT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$0000171C$FFEE9CBA$000018BC$000017EB$00001132$00001315$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBA$FFEE9CBAÿÇé*)
  3.